home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
ARK.ARJ
/
FM.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-10-07
|
31KB
|
1,345 lines
(****************************************************************************
(c) 1992 by Michelangelo Policarpo per Sound Blaster Digest Italia
Unit FM per la gestione diretta della sezione FM di una qualsiasi scheda
AdLib compatibile.
Versione 1.0 7/10/92 Primo rilascio al Pubblico Dominio
L'autore ha posto ogni cura (e tempo) nella realizzazione di queste routines,
testandole sotto svariate condizioni di uso.
A causa della varieta` delle condizioni e dell' hardware con cui queste pos-
sono essere utilizzate, non e` pero` possibile offrire alcuna garanzia sul
loro corretto funzionamento.
Chi usa questo pacchetto (o direttamente derivato) accetta implicitamente
tutte le le clausole qui riportate :
1. L' utente si assume ogni responsabilita` per gli eventuali danni che le
routines possono provocare, soprattutto a causa di un uso improprio del
prodotto.
2. L' utente deve riportare nella documentazione di accompagnamento del
software da lui prodotto il copyright sopra riportato o equivalente nota
di utilizzo di questo pacchetto.
QUESTO PACCHETTO VIENE RILASCIATO AL PUBBLICO DOMINIO E PERTANTO DEVE ESSERE
DISTRIBUITO LIBERAMENTE E GRATUITAMENTE. TALE PACCHETTO PUO` ANCHE ESSERE
MODIFICATO PURCHE` RIMANGA INTATTA LA NOTA DI COPYRIGHT E QUESTA PARTE DI
COMMENTO.
****************************************************************************)
unit FM;
interface
const
Melodic = 0;
Rhythmic = 1;
Undefined = $FF;
OFF = false;
ON = true;
const
FMErrorMsg : array[1..10] of string[31] =
('AdLib or SB card not present',
'Invalid note',
'Invalid voice',
'',
'',
'',
'',
'',
'',
'' );
{.BNK entry file structure}
type
Operator = record
KSL, FreqMult, Feedback, Attack,
SustLevel, EG, Decay, Release,
Output, AM, Vib, KSR, FM : byte
end;
type
InsDataPtr = ^InsData;
InsData = record
Mode, PercVoice : byte;
Op0, Op1 : Operator;
Wave0, Wave1 : byte
end;
{.INS file structure}
type
OPER = record
KSL, FreqMult, Feedback, Attack,
SustLevel, EG, Decay, Release,
Output, AM, Vib, KSR, FM : word
end;
INS = record
Mode : byte;
PercVoice : byte;
OPER0,OPER1 : OPER;
end;
INSEXT = record
INSBase : INS;
Wave0,Wave1 : word;
Pad : array[1..10] of word;
One : word;
end;
var
FMError : integer;
CurrentFMMode : byte;
BaseReg : word;
AdLibInstalled : boolean;
WaveFormEnabled, CSMModeEnabled, KBDSplitEnabled, AMDepthEnabled,
VIBDepthEnabled : boolean;
{Global variables}
procedure SetMelRhythm(State : boolean);
procedure SetWaveForm (State : boolean);
procedure SetCSMMode (State : boolean);
procedure SetKBDSplit (State : boolean);
procedure SetAMDepth (State : boolean);
procedure SetVIBDepth (State : boolean);
{Operator cells parameters}
{For any}
procedure SetAM (Ofs,Data : byte);
procedure SetVib (Ofs,Data : byte);
procedure SetEG (Ofs,Data : byte);
procedure SetKSR (Ofs,Data : byte);
procedure SetFreqMult (Ofs,Data : byte);
procedure SetKSL (Ofs,Data : byte);
procedure SetOutput (Ofs,Data : byte);
procedure SetAttack (Ofs,Data : byte);
procedure SetDecay (Ofs,Data : byte);
procedure SetSustLevel (Ofs,Data : byte);
procedure SetRelease (Ofs,Data : byte);
procedure SetWaveSel (Ofs,Data : byte);
{Only for modulator}
procedure SetFeedback (Ofs,Data : byte);
procedure SetFM (Ofs,Data : byte);
{For direct register access, CMF}
function ModOfs(channel : byte) : byte;
function CarOfs(channel : byte) : byte;
procedure SetSC(Ofs, Data : byte);
procedure SetSO(Ofs, Data : byte);
procedure SetAD(Ofs, Data : byte);
procedure SetSR(Ofs, Data : byte);
procedure SetWS(Ofs, Data : byte);
procedure SetFC(Ofs, Data : byte);
{General routines}
procedure SetFMMode (FMMode : byte);
procedure AssignVoice (Voice : byte; Ins : InsData);
procedure AllKeyOff;
procedure KeyOn (Voice, Note : byte);
procedure KeyOff (Voice : byte);
procedure QuitVoices;
procedure QuitVoice (Voice: byte);
procedure ResetVoice (Voice: byte);
procedure ResetSynth;
function FMStatus (voice : byte) : InsDataPtr;
procedure FMInit(Base : word);
function FindBasePort : boolean;
function FindSBPBasePort : word;
function IsAdLib : boolean;
implementation
type
InsArray = array[0..29] of byte;
const
FNumbers :
array[0..11] of word = (363,385,408,432,458,485,514,544,577,611,647,686);
{Offsets in registers array}
M_OpCell : array[1..9,0..1] of byte =
(($00,$03),($01,$04),($02,$05),
($08,$0B),($09,$0C),($0A,$0D),
($10,$13),($11,$14),($12,$15));
R_OpCell : array[1..11,0..1] of byte =
(($00,$03),($01,$04),($02,$05),
($08,$0B),($09,$0C),($0A,$0D),
($10,$13),($14,$FF),($12,$FF),
($15,$FF),($11,$FF));
Octave : array[0..95] of byte =
(0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,
2,2,2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,3,3,3,
4,4,4,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,
6,6,6,6,6,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7,7,7,7,7);
Semitone : array[0..95] of byte =
(0,1,2,3,4,5,6,7,8,9,10,11,0,1,2,3,4,5,6,7,8,9,10,11,
0,1,2,3,4,5,6,7,8,9,10,11,0,1,2,3,4,5,6,7,8,9,10,11,
0,1,2,3,4,5,6,7,8,9,10,11,0,1,2,3,4,5,6,7,8,9,10,11,
0,1,2,3,4,5,6,7,8,9,10,11,0,1,2,3,4,5,6,7,8,9,10,11);
{M/PV-1} {Op0} {v--caution!} {Op1} {WS}
Piano1 : InsArray = ( 0,00, 1, 1, 3,15, 5, 0, 1, 3,15, 0, 0, 0, 0, 0, 1, 0,13, 7, 0, 2, 4,16, 0, 0, 1, 0, 0,0);
BDrum1 : InsArray = ( 1,06, 0, 0, 0,10, 4, 0, 8,12,11, 0, 0, 0, 0, 0, 0,47,13, 4, 0, 6,15,16, 0, 0, 0, 1, 0,0);
Snare1 : InsArray = ( 1,07, 0,12, 0,15,11, 0, 8, 5,16, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,0);
Tom1 : InsArray = ( 1,08, 0, 4, 0,15,11, 0, 7, 5,16, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,0);
Cymbal1: InsArray = ( 1,09, 0, 1, 0,15,11, 0, 5, 5,16, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,0);
HiHat1 : InsArray = ( 1,10, 0, 1, 0,15,11, 0, 7, 5,16, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,0);
const
{Register offsets} {Range}
{First group : general}
R_TEST : byte = $01; {Test} {001h}
R_TIM1 : byte = $02; {Timer 1} {002h}
R_TIM2 : byte = $03; {Timer 2} {003h}
R_TIMC : byte = $04; {Timer Control} {004h}
R_CSMK : byte = $08; {CSM Mode/Keyboard Split} {008h}
R_AVR : byte = $BD; {AM VIB-Depth/Rhythm} {0BDh}
{Second group : for each operator cell}
R_AVEKM : byte = $20; {AM/VIB/EG/KSR/MULTIPLE} {020h-035h}
R_KTL : byte = $40; {KSL/Total Level} {040h-055h}
R_ARDR : byte = $60; {Attack Rate/Decay Rate} {060h-075h}
R_SLRR : byte = $80; {Sustain Level/Release Rate} {080h-095h}
R_WS : byte = $E0; {Wave Select} {0E0h-0F5h}
{Third group : for each channel}
R_FNUM : byte = $A0; {F-Number Low bits} {0A0h-0A8h}
R_BLK : byte = $B0; {F-Number High bits} {0B0h-0B8h}
R_FBC : byte = $C0; {Feedback/Connection} {0C0h-0C8h}
var
FMRegisters : array[0..$FF] of byte;
MelRhythm : boolean;
Install : boolean;
TmpInsData : InsData;
procedure OutCmd; assembler; {al = Address; ah = Data}
asm {OutCmd}
push ax
push dx
push bx
xor bx,bx
mov bl,al
mov byte ptr FMRegisters[bx],ah {UpDate buffer area}
pop bx
cmp Install,true
je @GoOn
cmp AdlibInstalled,true
jne @Exit
@GoOn:
mov dx,BaseReg
out dx,al
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
inc dx
mov al,ah
out dx,al
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
in al, dx
@Exit:
pop dx
pop ax
end; {OutCmd}
procedure SetAM(Ofs,Data : byte); assembler;
asm {SetAM}
mov al,Data
and al,00000001b
ror al,1
xor bx,bx
mov bl,Ofs
add bl,20h
mov ah,byte ptr FMRegisters[bx]
and ah,01111111b
or ah,al
mov al,bl
call OutCmd
end; {SetAM}
procedure SetVib(Ofs,Data : byte); assembler;
asm {SetVib}
mov al,Data
and al,00000001b
ror al,1
ror al,1
xor bx,bx
mov bl,Ofs
add bx,20h
mov ah,byte ptr FMRegisters[bx]
and ah,10111111b
or ah,al
mov al,bl
call OutCmd
end; {SetVib}
procedure SetEG(Ofs,Data : byte); assembler;
asm {SetEG}
mov al,Data
and al,00000001b
ror al,1
ror al,1
ror al,1
xor bx,bx
mov bl,Ofs
add bx,20h
mov ah,byte ptr FMRegisters[bx]
and ah,11011111b
or ah,al
mov al,bl
call OutCmd
end; {SetEG}
procedure SetKSR(Ofs,Data : byte); assembler;
asm {SetKSR}
mov al,Data
and al,00000001b
ror al,1
ror al,1
ror al,1
ror al,1
xor bx,bx
mov bl,Ofs
add bx,20h
mov ah,byte ptr FMRegisters[bx]
and ah,11101111b
or ah,al
mov al,bl
call OutCmd
end; {SetKSR}
procedure SetFreqMult(Ofs,Data : byte); assembler;
asm {SetFreqMult}
mov al,Data
and al,00001111b
xor bx,bx
mov bl,Ofs
add bx,20h
mov ah,byte ptr FMRegisters[bx]
and ah,11110000b
or ah,al
mov al,bl
call OutCmd
end; {SetFreqMult}
procedure SetKSL(Ofs,Data : byte); assembler;
asm {SetKSL}
mov al,Data
and al,00000011b
ror al,1
ror al,1
xor bx,bx
mov bl,Ofs
add bx,40h
mov ah,byte ptr FMRegisters[bx]
and ah,00111111b
or ah,al
mov al,bl
call OutCmd
end; {SetKSL}
procedure SetOutput(Ofs,Data : byte); assembler;
asm {SetOutput}
mov al,Data
and al,00111111b
xor bx,bx
mov bl,Ofs
add bx,40h
mov ah,byte ptr FMRegisters[bx]
and ah,11000000b
or ah,al
mov al,bl
call OutCmd
end; {SetOutput}
procedure SetAttack(Ofs,Data : byte); assembler;
asm {SetAttack}
mov al,Data
and al,00001111b
ror al,1
ror al,1
ror al,1
ror al,1
xor bx,bx
mov bl,Ofs
add bx,60h
mov ah,byte ptr FMRegisters[bx]
and ah,00001111b
or ah,al
mov al,bl
call OutCmd
end; {SetAttack}
procedure SetDecay(Ofs,Data : byte); assembler;
asm {SetDecay}
mov al,Data
and al,00001111b
xor bx,bx
mov bl,Ofs
add bx,60h
mov ah,byte ptr FMRegisters[bx]
and ah,11110000b
or ah,al
mov al,bl
call OutCmd
end; {SetDecay}
procedure SetSustLevel(Ofs,Data : byte); assembler;
asm {SetSustLevel}
mov al,Data
and al,00001111b
ror al,1
ror al,1
ror al,1
ror al,1
xor bx,bx
mov bl,Ofs
add bx,80h
mov ah,byte ptr FMRegisters[bx]
and ah,00001111b
or ah,al
mov al,bl
call OutCmd
end; {SetSustLevel}
procedure SetRelease(Ofs,Data : byte); assembler;
asm {SetRelease}
mov al,Data
and al,00001111b
xor bx,bx
mov bl,Ofs
add bx,80h
mov ah,byte ptr FMRegisters[bx]
and ah,11110000b
or ah,al
mov al,bl
call OutCmd
end; {SetRelease}
procedure SetWaveSel(Ofs,Data : byte); assembler;
asm {SetWaveSel}
mov al,Data
and al,00000011b
xor bx,bx
mov bl,Ofs
add bx,0E0h
mov ah,byte ptr FMRegisters[bx]
and ah,11111100b
or ah,al
mov al,bl
call OutCmd
end; {SetWaveSel}
procedure SetFeedback(Ofs,Data : byte); assembler;
asm {SetFeedback}
mov al,Data
and al,00000111b
shl al,1
xor bx,bx
mov bl,Ofs
add bx,0C0h
mov ah,byte ptr FMRegisters[bx]
and ah,11110001b
or ah,al
mov al,bl
call OutCmd
end; {SetFeedback}
procedure SetFM(Ofs,Data : byte); assembler;
asm {SetFM}
mov al,Data
and al,00000001b
xor bx,bx
mov bl,Ofs
add bx,0C0h
mov ah,byte ptr FMRegisters[bx]
and ah,11111110b
or ah,al
mov al,bl
call OutCmd
end; {SetFM}
procedure SetOpCellParameters(Offset : byte; Op : Operator; WaveSel : byte);
begin {SetOpCellParameters}
with Op do
begin
SetAM (Offset,AM);
SetVib (Offset,Vib);
SetEG (Offset,EG);
SetKSR (Offset,KSR);
SetFreqMult (Offset,FreqMult);
SetKSL (Offset,KSL);
SetOutput (Offset,Output);
SetAttack (Offset,Attack);
SetDecay (Offset,Decay);
SetSustLevel(Offset,SustLevel);
SetRelease (Offset,Release);
SetWaveSel (Offset,WaveSel)
end
end; {SetOpCellParameters}
procedure AssignVoice(Voice : byte; Ins : InsData);
begin {AssignVoice}
if Voice<=0 then
begin
FMError := 3;
Exit
end;
if (CurrentFMMode=Melodic) then
begin
if Voice>9 then
begin
FMError := 3;
Exit
end;
SetOpCellParameters(M_OpCell[Voice][0],Ins.OP0,Ins.Wave0);
with Ins.OP0 do
begin
SetFeedBack(Voice-1,FeedBack);
SetFM(Voice-1,FM);
end;
SetOpCellParameters(M_OpCell[Voice][1],Ins.OP1,Ins.Wave1);
end
else {Rhythmic}
begin
if Voice>11 then
begin
FMError := 3;
Exit
end;
SetOpCellParameters(R_OpCell[Voice][0],Ins.OP0,Ins.Wave0);
with Ins.OP0 do
begin
SetFeedBack(Voice-1,FeedBack);
if Voice<=9 then
SetFM(Voice-1,FM);
end;
if Voice<=7 then
SetOpCellParameters(R_OpCell[Voice][1],Ins.OP1,Ins.Wave1);
end
end; {AssignVoice}
procedure KeyOn(Voice, Note : byte); assembler;
{Note is the MIDI value for the note to play: note in [0..$5F]}
asm {KeyOn}
xor bx,bx
mov bl,Note
cmp bl,5Fh
jbe @NoteGood
mov FMError,2 {Invalid note}
jmp @Done
@NoteGood:
push bx
mov bl,byte ptr Semitone[bx] {bl = Semitone}
shl bx,1
mov bx,word ptr FNumbers[bx]
xchg ax,bx {ax = FNumber}
pop bx
mov bl,byte ptr Octave[bx] {bl = Octave}
and bl,07h;
shl bl,1
shl bl,1
or ah,bl {ax = Octave|F-Number}
mov dl,Voice
cmp dl,11
ja @BadVoice
cmp dl,0
jle @BadVoice
cmp dl,6 {Exclude Bass Drum}
jle @Melodic
cmp CurrentFMMode,1 {is Rhythmic?}
jne @Melodic {no, jump}
{@Rhythmic:}
cmp MelRhythm,1 {is Rhythmic section melodic-enabled?}
jne @GoOn {no: skip frequency control}
cmp dl,7 {is less than a Bass drum?}
jl @GoOn
cmp dl,11 {is more than Tom-Tom?}
jg @GoOn
xchg ax,bx
mov al,dl
dec al {al=offset}
add al,0A0h {register}
mov ah,bl {data : Lo(F-Number)}
call OutCmd
add al,010h {register}
mov ah,bh {data : KeyOn|Block|Hi(F-Number)}
call OutCmd
@GoOn:
mov cx,11
sub cl,Voice
mov al,01h
rol al,cl
mov ah,byte ptr FMRegisters[0BDh]
or ah,al
mov al,0BDh
call OutCmd
jmp @Done
@Melodic:
cmp dl,9
jg @BadVoice
or ah,20h {add KeyOn}
xchg ax,bx
mov al,dl
dec al {al=offset}
add al,0A0h {register}
mov ah,bl {data : Lo(F-Number)}
call OutCmd
add al,010h {register}
mov ah,bh {data : KeyOn|Block|Hi(F-Number)}
call OutCmd
jmp @Done
@BadVoice:
mov FMError,3
@Done:
end; {KeyOn}
procedure KeyOff(Voice : byte); assembler;
asm {KeyOff}
push cx
mov al,Voice
cmp al,6
jle @Melodic
test CurrentFMMode,1
jz @Melodic
mov cx,11
sub cl,al
js @Error
mov al,0FEh
rol al,cl
mov ah,byte ptr FMRegisters[0BDh]
and ah,al
mov al,0BDh
call OutCmd
jmp @Done
@Melodic:
cmp al,9
jg @Error
dec al
cmp al,0
jl @Error
add al,0B0h
xor bx,bx
mov bl,al
mov ah,byte ptr FMRegisters[bx]
and ah,11011111b
call OutCmd
jmp @Done
@Error:
mov FMError,3
@Done:
pop cx
end; {KeyOff}
procedure QuitVoice(Voice : byte);
begin {QuitVoice}
SetRelease(R_OpCell[Voice][0],15);
SetRelease(R_OpCell[Voice][1],15);
KeyOff(Voice);
end; {QuitVoice}
procedure QuitVoices; assembler;
asm {QuitVoices}
mov cx,3
mov ax,40h
@NextN:
push cx
mov cx,3
@NextM:
push cx
mov ah,7Fh
call OutCmd
add al,40h
mov ah,5Fh
call OutCmd
sub al,40h
add al,3
mov ah,3Fh
call OutCmd
add al,40h
mov ah,7Fh
call OutCmd
sub ax,40h
sub ax,2
pop cx
loop @NextM
add ax,5
pop cx
loop @NextN
mov cx,9
@NextA:
mov bx,cx
dec bx
add bx,0B0h
mov ah,byte ptr FMRegisters[bx]
and ah,11011111b
mov al,bl
call OutCmd
loop @NextA
mov ah,byte ptr FMRegisters[0BDh]
and ah,11100000b
mov al,0BDh
call OutCmd
end; {QuitVoices}
procedure SetWaveForm(State : boolean); assembler;
var
i : byte;
asm {SetWaveForm}
mov ah,State
and ah,1
mov WaveFormEnabled,ah
ror ah,1
ror ah,1
ror ah,1
mov al,1
call OutCmd
end; {SetWaveForm}
procedure AllKeyOff;
var
i : byte;
begin {AllKeyOff}
if CurrentFMMode=Melodic then
for i:=1 to 9 do
KeyOff(i)
else
for i:=1 to 11 do
KeyOff(i)
end; {AllKeyOff}
procedure SetCSMMode(State : boolean); assembler;
asm {SetCSMMode}
call AllKeyOff
mov ah,State
and ah,00000001b
mov CSMModeEnabled,ah
ror ah,1
mov al,byte ptr FMRegisters[8]
and al,01111111b
or ah,al
mov al,8
call OutCmd
end; {SetCSMMode}
procedure SetKBDSplit(State : boolean); assembler;
asm {SetKBDSplit}
mov ah,State
and ah,00000001b
mov KBDSplitEnabled,ah
ror ah,1
ror ah,1
mov al,byte ptr FMRegisters[8]
and al,10111111b
or ah,al
mov al,8
call OutCmd
end; {SetKBDSplit}
procedure SetAMDepth(State : boolean); assembler;
asm {SetAMDepth}
mov ah,State
and ah,00000001b
mov AMDepthEnabled,ah
ror ah,1
mov al,byte ptr FMRegisters[0BDh]
and al,01111111b
or ah,al
mov al,0BDh
call OutCmd
end; {SetAMDepth}
procedure SetVIBDepth(State : boolean); assembler;
asm {SetVIBDepth}
mov ah,State
and ah,00000001b
mov VIBDepthEnabled,ah
ror ah,1
ror ah,1
mov al,byte ptr FMRegisters[0BDh]
and al,10111111b
or ah,al
mov al,0BDh
call OutCmd
end; {SetVIBDepth}
procedure SetFMMode(FMMode : byte); assembler;
asm {SetFMMode}
call QuitVoices
mov al,FMMode
and al,00000001b
mov CurrentFMMode,al
shl al,1
shl al,1
shl al,1
shl al,1
shl al,1 {Shift bit to D5}
mov ah,byte ptr FMRegisters[0BDh]
and ah,11000000b
or ah,al
mov al,0BDh
call OutCmd
end; {SetFMMode}
procedure SetMelRhythm(State : boolean);
begin {SetMelRhythm}
MelRhythm := State
end; {SetMelRhythm}
{* compatibility with CMF modes *}
procedure SetSC(Ofs, Data : byte); assembler;
asm {SetSC}
mov ah,Data
mov al,Ofs
add al,020h
call OutCmd
end; {SetSC}
procedure SetSO(Ofs, Data : byte); assembler;
asm {SetSO}
mov ah,Data
mov al,Ofs
add al,040h
call OutCmd
end; {SetSO}
procedure SetAD(Ofs, Data : byte); assembler;
asm {SetAD}
mov ah,Data
mov al,Ofs
add al,060h
call OutCmd
end; {SetAD}
procedure SetSR(Ofs, Data : byte); assembler;
asm {SetSR}
mov ah,Data
mov al,Ofs
add al,080h
call OutCmd
end; {SetSR}
procedure SetWS(Ofs, Data : byte); assembler;
asm {SetWS}
mov ah,Data
mov al,Ofs
add al,0E0h
call OutCmd
end; {SetWS}
procedure SetFC(Ofs, Data : byte); assembler;
asm {SetFC}
mov ah,Data
mov al,Ofs
add al,0C0h
call OutCmd
end; {SetFC}
function ModOfs(channel : byte) : byte;
begin {ModOfs}
case CurrentFMMode of
Melodic :
ModOfs := M_OpCell[channel+1,0];
Rhythmic:
if channel<6 then
ModOfs := R_OpCell[channel+1,0]
else
ModOfs := R_OpCell[channel-5,0]
end
end; {ModOfs}
function CarOfs(channel : byte) : byte;
begin {CarOfs}
case CurrentFMMode of
Melodic :
CarOfs := M_OpCell[channel+1,1];
Rhythmic:
if channel<6 then
CarOfs := R_OpCell[channel+1,1]
else
CarOfs := R_OpCell[channel-5,1]
end
end; {CarOfs}
{* end of compatibility with CMF modes *}
procedure ResetTimers; assembler;
asm {ResetTimers}
mov ah,60h
mov al,04h
call OutCmd {Mask T1 & T2}
mov ah,80h
mov al,04h
call OutCmd {Reset IRQ}
end; {ResetTimers}
procedure ResetRegisters; assembler;
asm {ResetRegisters}
mov cx,0F5h
@NextReg:
mov ax,cx
call OutCmd
loop @NextReg
end; {ResetRegisters}
procedure ResetVariables;
begin {ResetVariables}
SetWaveForm(ON);
SetCSMMode(OFF);
SetKBDSplit(ON);
SetAMDepth(OFF);
SetVIBDepth(OFF)
end; {ResetVariables}
procedure ResetPitch; assembler;
asm {ResetPitch}
mov al,CurrentFMMode
cmp al,0
jne @Rhythm
mov cx,9
mov bx,57A0h
mov dx,01B0h
@NextVoice:
mov ax,bx
call OutCmd
inc bx
mov ax,dx
call OutCmd
inc dx
loop @NextVoice
jmp @RPExit
@Rhythm:
mov ax,57A0h {Voice 1}
call OutCmd
mov ax,11B0h
call OutCmd
mov ax,57A1h {Voice 2}
call OutCmd
mov ax,01B1h
call OutCmd
mov ax,57A2h {Voice 3}
call OutCmd
mov ax,01B2h
call OutCmd
mov ax,57A3h {Voice 4}
call OutCmd
mov ax,01B3h
call OutCmd
mov ax,57A4h {Voice 5}
call OutCmd
mov ax,01B4h
call OutCmd
mov ax,57A5h {Voice 6}
call OutCmd
mov ax,01B5h
call OutCmd
mov ax,57A6h {Bass drum}
call OutCmd
mov ax,09B6h {Warning!!! was : 01B6}
call OutCmd
mov ax,03A7h {Snare drum & Hi-Hat}
call OutCmd
mov ax,0AB7h
call OutCmd
mov ax,57A8h {Tom & Cymbal}
call OutCmd
mov ax,09B8h
call OutCmd
@RPExit:
end; {ResetPitch}
procedure ResetVoice(Voice:byte);
begin {ResetVoice}
if (CurrentFMMode=Melodic) or (Voice<=6) then
AssignVoice(Voice,InsData(Piano1))
else
case Voice of
7 : AssignVoice(7,InsData(BDrum1));
8 : AssignVoice(8,InsData(Snare1));
9 : AssignVoice(9,InsData(Tom1));
10: AssignVoice(10,InsData(Cymbal1));
11: AssignVoice(11,InsData(HiHat1))
end;
end; {ResetVoice}
procedure ResetSynth;
begin {ResetSynth}
ResetVariables;
AssignVoice(1,InsData(Piano1));
AssignVoice(2,InsData(Piano1));
AssignVoice(3,InsData(Piano1));
AssignVoice(4,InsData(Piano1));
AssignVoice(5,InsData(Piano1));
AssignVoice(6,InsData(Piano1));
if CurrentFMMode=Melodic then
begin
AssignVoice(7,InsData(Piano1));
AssignVoice(8,InsData(Piano1));
AssignVoice(9,InsData(Piano1));
end
else
begin
AssignVoice(7,InsData(BDrum1));
AssignVoice(8,InsData(Snare1));
AssignVoice(9,InsData(Tom1));
AssignVoice(10,InsData(Cymbal1));
AssignVoice(11,InsData(HiHat1))
end;
ResetPitch
end; {ResetSynth}
function FMStatus(voice : byte) : InsDataPtr;
begin {FMStatus}
with TmpInsData do
begin
Mode := 0;
PercVoice := 0;
if (Voice in [7..11]) and (CurrentFMMode=Rhythmic) then
begin
Mode := 1;
PercVoice := Voice-1
end;
with Op0 do
begin
FreqMult := (FMRegisters[$20+R_OpCell[Voice][0]] and $0F);
KSR := (FMRegisters[$20+R_OpCell[Voice][0]] and $10) shr 4;
EG := (FMRegisters[$20+R_OpCell[Voice][0]] and $20) shr 5;
Vib := (FMRegisters[$20+R_OpCell[Voice][0]] and $40) shr 6;
AM := (FMRegisters[$20+R_OpCell[Voice][0]] and $80) shr 7;
Output := (FMRegisters[$40+R_OpCell[Voice][0]] and $3F);
KSL := (FMRegisters[$40+R_OpCell[Voice][0]]) shr 6;
Decay := (FMRegisters[$60+R_OpCell[Voice][0]] and $0F);
Attack := (FMRegisters[$60+R_OpCell[Voice][0]]) shr 4;
Release := (FMRegisters[$80+R_OpCell[Voice][0]] and $0F);
SustLevel := (FMRegisters[$80+R_OpCell[Voice][0]]) shr 4;
if (Mode=0) or (Voice<=7) then
begin
FM := (FMRegisters[$C0+Voice-1] and $01);
FeedBack := (FMRegisters[$C0+Voice-1] and $0E) shr 1;
end
else
begin
FM := 0;
Feedback := 0;
end;
end;
Wave0 := (FMRegisters[$E0+R_OpCell[Voice][0]] and $03);
if (Voice in [8..11]) and (CurrentFMMode=Rhythmic) then
with Op1 do
begin
Attack := 15;
SustLevel := 15;
Decay := 15;
Release := 15;
KSL := 0;
FreqMult := 0;
FeedBack := 0;
EG := 0;
Output := 63;
AM := 0;
Vib := 0;
KSR := 0;
FM := 0;
Wave1 := 0
end
else
with Op1 do
begin
FreqMult := (FMRegisters[$20+M_OpCell[Voice][1]] and $0F);
KSR := (FMRegisters[$20+M_OpCell[Voice][1]] and $10) shr 4;
EG := (FMRegisters[$20+M_OpCell[Voice][1]] and $20) shr 5;
Vib := (FMRegisters[$20+M_OpCell[Voice][1]] and $40) shr 6;
AM := (FMRegisters[$20+M_OpCell[Voice][1]] and $80) shr 7;
Output := (FMRegisters[$40+M_OpCell[Voice][1]] and $3F);
KSL := (FMRegisters[$40+M_OpCell[Voice][1]]) shr 6;
Decay := (FMRegisters[$60+M_OpCell[Voice][1]] and $0F);
Attack := (FMRegisters[$60+M_OpCell[Voice][1]]) shr 4;
Release := (FMRegisters[$80+M_OpCell[Voice][1]] and $0F);
SustLevel := (FMRegisters[$80+M_OpCell[Voice][1]]) shr 4;
FM := 0;
Feedback := 0;
Wave1 := (FMRegisters[$E0+M_OpCell[Voice][1]] and $03)
end
end;
FMStatus := @TmpInsData
end; {FMStatus}
procedure FMInit(Base : word);
begin {FMInit}
BaseReg := Base;
Install := true;
AdLibInstalled := IsAdLib;
Install := false;
if not(AdLibInstalled) then
FMError := 1
else
begin
FMError := 0;
ResetRegisters;
ResetTimers;
SetFMMode(Rhythmic);
SetMelRhythm(OFF);
ResetSynth
end
end; {FMInit}
function IsAdLib : boolean; assembler;
asm {IsAdLib}
call ResetTimers
mov dx,BaseReg
in al,dx {Read T1}
push ax {Save T1}
mov ah,0FFh
mov al,02h
call OutCmd {Set Timer 1 latch}
mov ah,21h
mov al,04h
call OutCmd {Unmask & start T1}
mov dx,BaseReg
mov cx,200
@Again:
in al,dx
loop @Again {100 uSec delay for timer-1 overflow}
{al = T2}
push ax
call ResetTimers
pop bx {T2 in bl}
pop ax {T1 in al}
and bl,0E0h
cmp bl,0C0h
jnz @AdLibNotFound
and al,0E0h
cmp al,0
jnz @AdLibNotFound
mov ax,1 {return true}
jmp @IsAdLibExit
@AdLibNotFound:
xor ax,ax {return false}
@IsAdLibExit:
end; {IsAdLib}
function FindBasePort : boolean;
const
BasePort : array[1..9] of word = ($388,$318,$218,$228,$238,$248,$258,$268,$288);
var
i : byte;
begin {FindBasePort}
i := 1;
repeat
FMInit(BasePort[i]);
inc(i)
until (FMError=0) or (i>9);
FindBasePort := FMError=0;
end; {FindBasePort}
function FindSBPBasePort : word;
const
BasePort : array[1..2] of word = ($248,$228);
var
i : byte;
J,K : byte;
begin {FindSBPBasePort}
i := 1;
repeat
FMInit(BasePort[i]);
if FMError=0 then
begin
Port[BaseReg-4] := $06;
J := Port[BaseReg-3];
Port[BaseReg-4] := $06;
Port[BaseReg-3] := $26;
Port[BaseReg-4] := $06;
K := Port[BaseReg-3];
if K<>$37 then
FMError := 8
else
Port[BaseReg-3] := J;
end;
inc(i)
until (FMError=0) or (i>2);
if FMError=0 then
FindSBPBasePort := BaseReg
else
FindSBPBasePort := 0
end; {FindSBPBasePort}
begin {FM}
FMError := 0;
BaseReg := $0388;
CurrentFMMode := Undefined
end. {FM}